unit COMM_ModeBus;

interface

uses  Classes
 ,SysUtils
 ,ModBusConsts
 ,ModbusTypes
 ,Types;

type
  TModeBus = class
  private
    FAutoConnect: Boolean;
    FBaseRegister: Word;
    //FOnResponseError: TModbusClientErrorEvent;
    //FOnResponseMismatch: TModBusClientResponseMismatchEvent;
    FLastTransactionID: Word;
    FReadTimeout: Integer;
    FTimeOut: Cardinal;
    FUnitID: Byte;
  public
    function ReadHoldingRegisters(const RegNo:Word; const Blocks:Word;
        out RegisterData:array of Word):Boolean;
    function WriteRegisters(const RegNo:Word; const RegisterData:array of Word):Boolean;
    function SendCommand(const AModBusFunction:TModBusFunction;
        const ARegNumber:Word;const ABlockLength:Word; var Data:array of Word): Boolean;
  end;


      
implementation

uses ModbusUtils;

function TModeBus.ReadHoldingRegisters(const RegNo:Word; const Blocks:Word;
    out RegisterData:array of Word):Boolean;
var
  i: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  {if FAutoConnect and not Connected then
  begin
    Connect(FConnectTimeOut);
    bNewConnection := True;
  end;   }

  try
    SetLength(Data, Blocks);
    FillChar(Data[0], Length(Data), 0);
    Result := SendCommand(mbfReadHoldingRegs, RegNo, Blocks, Data);
    for i := Low(Data) to High(Data) do
      RegisterData[i] := Data[i];
  finally
    {if bNewConnection then
      DisConnect;     }
  end;
end;

function TModeBus.WriteRegisters(const RegNo:Word; const RegisterData:array of Word):Boolean;
var
  i: Integer;
  iBlockLength: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  iBlockLength := High(RegisterData) - Low(RegisterData) + 1;
  {if FAutoConnect and not Connected then
  begin
    Connect(FConnectTimeOut);
    bNewConnection := True;
  end;  }

  try
    SetLength(Data, Length(RegisterData));
    for i := Low(RegisterData) to High(RegisterData) do
      Data[i] := RegisterData[i];
    Result := SendCommand(mbfWriteRegs, RegNo, iBlockLength, Data);
  finally
    {if bNewConnection then
      DisConnect; }
  end;
end;

function TModeBus.SendCommand(const AModBusFunction:TModBusFunction;
    const ARegNumber:Word;const ABlockLength:Word; var Data:array of Word): Boolean;
var
  SendBuffer: TModBusRequestBuffer;
  ReceiveBuffer: TModBusResponseBuffer;
  BlockLength: Word;
  RegNumber: Word;
  dtTimeOut: TDateTime;
begin

  {TODO:
  CheckForDisconnect(True, True);
  SendBuffer.Header.TransactionID := GetNewTransactionID;    }
  SendBuffer.Header.ProtocolID := MB_PROTOCOL;
{ Initialise data related variables }
  RegNumber := ARegNumber - FBaseRegister;
{ Perform function code specific operations }
  case AModBusFunction of
    mbfReadCoils,
    mbfReadInputBits:
      begin
        BlockLength := ABlockLength;
      { Don't exceed max length }
        if (BlockLength > 250) then
          BlockLength := 250;
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfReadHoldingRegs,
    mbfReadInputRegs:
      begin
        BlockLength := ABlockLength;
        if (BlockLength > 125) then
          BlockLength := 125; { Don't exceed max length }
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfWriteOneCoil:
      begin
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        if (Data[0] <> 0) then
          SendBuffer.MBPData[2] := 255
        else
          SendBuffer.MBPData[2] := 0;
        SendBuffer.MBPData[3] := 0;
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfWriteOneReg:
      begin
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(Data[0]);
        SendBuffer.MBPData[3] := Lo(Data[0]);
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfWriteCoils:
      begin
        BlockLength := ABlockLength;
      { Don't exceed max length }
        if (BlockLength > 250) then
          BlockLength := 250;
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.MBPData[4] := Byte((BlockLength + 7) div 8);
        PutCoilsIntoBuffer(@SendBuffer.MBPData[5], BlockLength, Data);
        SendBuffer.Header.RecLength := Swap16(7 + SendBuffer.MBPData[4]);
      end;
    mbfWriteRegs:
      begin
        BlockLength := ABlockLength;
      { Don't exceed max length }
        if (BlockLength > 250) then
          BlockLength := 250;
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.MbpData[4] := Byte(BlockLength shl 1);
        PutRegistersIntoBuffer(@SendBuffer.MBPData[5], BlockLength, Data);
        SendBuffer.Header.RecLength := Swap16(7 + SendBuffer.MbpData[4]);
      end;
  end;
{ Writeout the data to the connection 
  WriteBuffer(SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);   }
{*** Wait for data from the PLC ***
  if (FTimeOut > 0) then
  begin
    dtTimeOut := Now + (FTimeOut / 86400000);
    while (InputBuffer.Size = 0) do
    begin
      if Socket.Binding.Readable(FReadTimeout) then
        ReadFromStack;
      if (Now > dtTimeOut) then
      begin
        Result := False;
        Exit;
      end;
    end;
  end;
  Result := True;
  ReadBuffer(ReceiveBuffer, InputBuffer.Size);        }
{ Check if the result has the same function code as the request
  if (AModBusFunction = ReceiveBuffer.FunctionCode) then
  begin
    case AModBusFunction of
      mbfReadCoils,
      mbfReadInputBits:
        begin
          BlockLength := ReceiveBuffer.MBPData[0] * 8;
          if (BlockLength > 250) then
            BlockLength := 250;
          GetCoilsFromBuffer(@ReceiveBuffer.MBPData[1], BlockLength, Data);
        end;
      mbfReadHoldingRegs,
      mbfReadInputRegs:
        begin
          BlockLength := (ReceiveBuffer.MBPData[0] shr 1);
          if (BlockLength > 125) then
            BlockLength := 125;
          GetRegistersFromBuffer(@ReceiveBuffer.MBPData[1], BlockLength, Data);
        end;
    end;
  end
  else
  begin
    if ((AModBusFunction or $80) = ReceiveBuffer.FunctionCode) then
      DoResponseError(AModBusFunction, ReceiveBuffer.MBPData[0], ReceiveBuffer)
    else
      DoResponseMismatch(AModBusFunction, ReceiveBuffer.FunctionCode, ReceiveBuffer);
    Result := False;
  end;         }

end;

end.
